home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / KERMCRC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-04  |  2.3 KB  |  49 lines
  1. (*----------------------------------------------------------------------*)
  2. (*       Kermit_CRC --- Update cyclic redundancy check for Kermit       *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Kermit_CRC( Old_CRC: INTEGER; B: BYTE ) : INTEGER;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Function:   Kermit_CRC                                           *)
  10. (*                                                                      *)
  11. (*     Purpose:    Computes cyclic redundancy check for 1 character     *)
  12. (*                 for Kermit protocol.                                 *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        New_CRC := Kermit_CRC( Old_CRC : INTEGER;                     *)
  17. (*                               B       : BYTE ) : INTEGER;            *)
  18. (*                                                                      *)
  19. (*           Old_CRC --- previous CRC value.                            *)
  20. (*           B       --- character for which CRC is computed.           *)
  21. (*           New_CRC --- updated CRC.                                   *)
  22. (*                                                                      *)
  23. (*     Calls:    None                                                   *)
  24. (*                                                                      *)
  25. (*----------------------------------------------------------------------*)
  26.  
  27. VAR
  28.    C     : BYTE;
  29.    CSave : BYTE;
  30.  
  31. CONST
  32.    CrcTab:  ARRAY[0..15] OF INTEGER
  33.             = ( $0000, $1081, $2102, $3183, $4204, $5285, $6306, $7387,
  34.                 $8408, $9489, $A50A, $B58B, $C60C, $D68D, $E70E, $F78F  );
  35.  
  36.    CrcTab2: ARRAY[0..15] OF INTEGER
  37.             = ( $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
  38.                 $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7  );
  39.  
  40. BEGIN (* Kermit_CRC *)
  41.  
  42.    C     := B XOR LO( Old_CRC );
  43.    CSave := ( C AND $F0 ) SHR 4;
  44.    C     := C AND $0F;
  45.  
  46.    Kermit_CRC   := ( Old_CRC SHR 8 ) XOR ( CrcTab[ CSave ] XOR CrcTab2[ C ] );
  47.  
  48. END   (* Kermit_CRC *);
  49.